home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / COMPLEX.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.4 KB  |  204 lines
  1. 10  ' *********************
  2. 20  ' **     COMPLEX     **
  3. 30  ' *********************
  4. 40  '
  5. 50  CLEAR
  6. 60  SCREEN 0,0,0,0
  7. 70  CLS
  8. 80  KEY OFF
  9. 90  LOCATE 2,21
  10. 100  PRINT "* * *  COMPLEX NUMBER CALCULATOR  * * *
  11. 110  LOCATE 4,1
  12. 120  PRINT "Functions for one complex number  ...  SQR(), EXP(), LOG(), 1/()
  13. 130  PRINT "Functions for two complex numbers ...  + - * /
  14. 140  PRINT
  15. 150  PRINT "Results are returned in variables A and B, and may be used in
  16. 160  PRINT "further calculations.  Use of (A+iB) or () inputs previous results
  17. 170  PRINT
  18. 180  PRINT "Examples of legal input ...
  19. 190  PRINT TAB(20)"(3+i4)+(2-i2)
  20. 200  PRINT TAB(20)"(3+i4)*(2)
  21. 210  PRINT TAB(20)"(a+ib)*(2)
  22. 220  PRINT TAB(20)"*(2-i3)       ...same as (A+iB)*(2-i3)
  23. 230  PRINT TAB(20)"(2-i3)*()     ...same as (2-i3)*(A-iB)
  24. 240  PRINT TAB(20)"+(j4)
  25. 250  PRINT
  26. 260  PRINT "Spaces may be used anywhere.
  27. 270  PRINT "You may use either 'i' or 'j' for the imaginary part.
  28. 280  PRINT "All values should be enclosed in parenthesis.
  29. 290  PRINT "Simply type in your problems and press the enter key.
  30. 300  PRINT
  31. 310  PRINT TAB(20)"PRESS THE SPACE BAR TO BEGIN"
  32. 320  K$ = INKEY$
  33. 330  IF K$ <> " " THEN 320
  34. 340  CLS
  35. 350  GOTO 1450
  36. 360  '
  37. 370  LOCATE 24,5
  38. 380  PRINT "} ";
  39. 390  LINE INPUT FUN$
  40. 400  GOSUB 1740
  41. 410  GOSUB 1820
  42. 420  PP = INSTR(FUN$,"()")
  43. 430  IF PP = 0 THEN 460
  44. 440  FUN$ = LEFT$(FUN$,PP-1) + "(A+IB)" + MID$(FUN$,PP+2)
  45. 450  GOTO 420
  46. 460  C$ = FUN$
  47. 470  LP = INSTR(C$,"(")
  48. 480  RP = INSTR(C$,")")
  49. 490  IF LP = 0 OR RP - LP < 2 THEN 2010
  50. 500  D$ = MID$(C$,LP+1,RP-LP-1)
  51. 510  GOSUB 1520
  52. 520  R1 = R : R2 = 0
  53. 530  I1 = I : I2 = 0
  54. 540  C$ = LEFT$(C$,LP-1) + MID$(C$,RP+1)
  55. 550  LP = INSTR(C$,"(")
  56. 560  RP = INSTR(C$,")")
  57. 570  IF C$ <> "" THEN 610
  58. 580  A = R1
  59. 590  B = I1
  60. 600  GOTO 920
  61. 610  IF LP AND (RP - LP > 1) THEN 670
  62. 620  R2 = R1
  63. 630  I2 = I1
  64. 640  R1 = A
  65. 650  I1 = B
  66. 660  GOTO 740
  67. 670  D$ = MID$(C$,LP+1,RP-LP-1)
  68. 680  C$ = LEFT$(C$,LP-1) + MID$(C$,RP+1)
  69. 690  GOSUB 1520
  70. 700  R2 = R
  71. 710  I2 = I
  72. 720  '
  73. 730  ' Addition
  74. 740  IF INSTR(C$,"+") = 0 THEN 800
  75. 750  A = R1 + R2
  76. 760  B = I1 + I2
  77. 770  GOTO 1370
  78. 780  '
  79. 790  ' Subtraction
  80. 800  IF INSTR(C$,"-") = 0 THEN 860
  81. 810  A = R1 - R2
  82. 820  B = I1 - I2
  83. 830  GOTO 1370
  84. 840  '
  85. 850  ' Multiplication
  86. 860  IF INSTR(C$,"*") = 0 THEN 920
  87. 870  A = R1 * R2 - I1 * I2
  88. 880  B = R1 * I2 + I1 * R2
  89. 890  GOTO 1370
  90. 900  '
  91. 910  ' Division
  92. 920  IF INSTR(C$,"/") = 0 THEN 1010
  93. 930  IF INSTR(C$,"1/") THEN 1010
  94. 940  NUM = R1 * R2 + I1 * I2
  95. 950  DEN = R2 * R2 + I2 * I2
  96. 960  A = NUM / DEN
  97. 970  B = (I1 * R2 - R1 * I2) / DEN
  98. 980  GOTO 1370
  99. 990  '
  100. 1000  ' Exponential
  101. 1010  IF INSTR(C$,"EXP") = 0 THEN 1070
  102. 1020  A = EXP(R2) * COS(I2)
  103. 1030  B = EXP(R2) * SIN(I2)
  104. 1040  GOTO 1370
  105. 1050  '
  106. 1060  ' Natural Logarithm
  107. 1070  IF INSTR(C$,"LOG") = 0 THEN 1210
  108. 1080  X = R2
  109. 1090  Y = I2
  110. 1100  GOSUB 1890
  111. 1110  IF MAG > 0 THEN 1160
  112. 1120  LOCATE 24,40
  113. 1130  PRINT "Illegal value for LOG function"
  114. 1140  A = 0
  115. 1150  GOTO 1170
  116. 1160  A = LOG(MAG)
  117. 1170  B = ANG
  118. 1180  GOTO 1370
  119. 1190  '
  120. 1200  ' Square Root
  121. 1210  IF INSTR(C$,"SQR") = 0 THEN 1270
  122. 1220  A = SQR((R2 + SQR(R2 * R2 + I2 * I2)) / 2)
  123. 1230  B = I2 / A / 2
  124. 1240  GOTO 1370
  125. 1250  '
  126. 1260  ' Inverse
  127. 1270  IF INSTR(C$,"1/") = 0 THEN 1330
  128. 1280  R1 = 1
  129. 1290  I1 = 0
  130. 1300  GOTO 940
  131. 1310  '
  132. 1320  ' Function not recognized
  133. 1330  LOCATE 24,40
  134. 1340  IF LEN(C$) THEN PRINT "Unknown function
  135. 1350  '
  136. 1360  ' output of result
  137. 1370  LOCATE 24,40
  138. 1380  PRINT "=  ";
  139. 1390  FUN$ = "(" + STR$(A) + "+i" + STR$(B) + ")"
  140. 1400  GOSUB 1820
  141. 1410  PTR = INSTR(FUN$,"+i-")
  142. 1420  IF PTR THEN MID$(FUN$,PTR,3) = " -i"
  143. 1430  GOSUB 1820
  144. 1440  PRINT FUN$
  145. 1450  LOCATE 1,1
  146. 1460  PRINT TAB(9)"Functions ...   +  -  *  /  SQR()  EXP()  LOG()  1/()
  147. 1470  PRINT TAB(9)"Returned  ...   (A+iB)  'A' and/or 'B' may be used for input
  148. 1480  PRINT SPACE$(160)
  149. 1490  GOTO 370
  150. 1500  '
  151. 1510  ' subroutine for separating out R and I from D$
  152. 1520  FUN$ = D$
  153. 1530  GOSUB 1820
  154. 1540  DA = INSTR(FUN$,"A")
  155. 1550  IF DA = 0 THEN 1580
  156. 1560  D$ = LEFT$(FUN$,DA-1) + STR$(A) + MID$(FUN$,DA+1)
  157. 1570  GOTO 1520
  158. 1580  DB = INSTR(FUN$,"B")
  159. 1590  IF DB = 0 THEN 1620
  160. 1600  D$ = LEFT$(FUN$,DB-1) + STR$(B) + MID$(FUN$,DB+1)
  161. 1610  GOTO 1520
  162. 1620  JP = INSTR(FUN$,"I")
  163. 1630  IF JP = 0 THEN JP = INSTR(FUN$,"J")
  164. 1640  I = 0
  165. 1650  R = VAL(D$)
  166. 1660  IF JP = 0 THEN 1710
  167. 1670  I = VAL(MID$(FUN$,JP+1))
  168. 1680  IF JP = LEN(FUN$) THEN I = 1
  169. 1690  IF JP < 2 THEN 1710
  170. 1700  IF MID$(FUN$,JP-1,1) = "-" THEN I = -I
  171. 1710  RETURN
  172. 1720  '
  173. 1730  ' subroutine for capitalization
  174. 1740  FOR CHAR = 1 TO LEN(FUN$)
  175. 1750  IF MID$(FUN$,CHAR,1) < "a" THEN 1780
  176. 1760  IF MID$(FUN$,CHAR,1) > "z" THEN 1780
  177. 1770  MID$(FUN$,CHAR,1) = CHR$(ASC(MID$(FUN$,CHAR,1))-32)
  178. 1780  NEXT CHAR
  179. 1790  RETURN
  180. 1800  '
  181. 1810  ' subroutine to remove spaces
  182. 1820  SP = INSTR(FUN$," ")
  183. 1830  IF SP = 0 THEN 1860
  184. 1840  FUN$ = LEFT$(FUN$,SP-1) + MID$(FUN$,SP+1)
  185. 1850  GOTO 1820
  186. 1860  RETURN
  187. 1870  '
  188. 1880  ' subroutine ... rectangular to polar ... X,Y to MAG,ANG
  189. 1890  MAG = SQR(X*X + Y*Y)
  190. 1900  NINETY = 2 * ATN(1)
  191. 1910  IF X THEN ANG = ATN(Y/X) ELSE ANG = NINETY * ((Y<0) - (Y>0))
  192. 1920  IF X < 0 THEN ANG = ANG + 2 * NINETY * ((ANG>0) - (ANG<=0))
  193. 1930  RETURN
  194. 1940  '
  195. 1950  ' subroutine ... polar to rectangular ... MAG,ANG to X,Y
  196. 1960  X = MAG * COS(ANG)
  197. 1970  Y = MAG * SIN(ANG)
  198. 1980  RETURN
  199. 1990  '
  200. 2000  ' no comprehendo
  201. 2010  LOCATE 24,40
  202. 2020  PRINT "Syntax problem ... try again"
  203. 2030  GOTO 1370
  204.